home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / you-075a.lha / you-075a / funcalls.h < prev    next >
C/C++ Source or Header  |  1992-06-18  |  6KB  |  246 lines
  1. /* 
  2.  * macros for calling eulispII functions
  3.  */
  4.  
  5. #ifndef FUNCALLS_H
  6. #define FUNCALLS_H
  7.  
  8. #define ARG_STACK_PUSH(x) STACK(x)
  9. #define ARG_STACK_POP(x) STACK(x)
  10.  
  11. #define CALL_FN(function,args) \
  12.   function(stacktop,stacktop+number_of_args)
  13.  
  14. #define ARG_0(stack) (*stack)
  15. #define ARG_1(stack) (*(stack+1))
  16. #define ARG_2(stack) (*(stack+2))
  17. #define ARG_3(stack) (*(stack+3))
  18.  
  19. #ifdef __STDC__
  20. #define EUDECL(fun)  \
  21. LispObject fun(LispObject *)
  22.  
  23. #define EUFUN_0(name) LispObject name(LispObject *stackbase) \
  24.                       { LispObject *stacktop = stackbase; \
  25.             /*toplabel:*/
  26.  
  27. #define EUFUN_1(name,arg)  \
  28. LispObject name (LispObject *stackbase) \
  29.   { \
  30.       LispObject arg; \
  31.       LispObject *stacktop = stackbase+1; \
  32.    /*toplabel:*/ \
  33.       arg = ARG_0(stackbase); \
  34.  
  35. #define EUFUN_2(name,a1,a2) \
  36. LispObject name (LispObject *stackbase) \
  37.   { \
  38.     LispObject a1; \
  39.     LispObject a2; \
  40.     LispObject *stacktop = stackbase+2; \
  41.  /*toplabel:*/ \
  42.     a1 = ARG_0(stackbase); \
  43.     a2 = ARG_1(stackbase);
  44.  
  45. #define EUFUN_3(name, a1, a2, a3) \
  46.   LispObject name (LispObject *stackbase) \
  47.     { \
  48.       LispObject a1; \
  49.       LispObject a2; \
  50.       LispObject a3; \
  51.       LispObject *stacktop = stackbase+3; \
  52.    /*toplabel:*/ \
  53.       a1 = ARG_0(stackbase); \
  54.       a2 = ARG_1(stackbase); \
  55.       a3 = ARG_2(stackbase);
  56.  
  57. #define EUFUN_4(name, a1, a2, a3, a4) \
  58.   LispObject name (LispObject *stackbase) \
  59.     { \
  60.       LispObject a1; \
  61.       LispObject a2; \
  62.       LispObject a3; \
  63.       LispObject a4; \
  64.       LispObject *stacktop = stackbase+4; \
  65.    /*toplabel:*/ \
  66.       a1 = ARG_0(stackbase); \
  67.       a2 = ARG_1(stackbase); \
  68.       a3 = ARG_2(stackbase); \
  69.       a4 = ARG_3(stackbase);
  70.  
  71. #else
  72. #define EUDECL(fun)  \
  73. LispObject fun()
  74.  
  75. #define EUFUN_0(name) \
  76. LispObject name(stackbase) \
  77. LispObject *stackbase; \
  78.   { LispObject *stacktop = stackbase; \
  79.       /*toplabel:*/
  80.  
  81. #define EUFUN_1(name,arg)  \
  82. LispObject name (stackbase) \
  83. LispObject *stackbase; \
  84.   { \
  85.       LispObject arg; \
  86.       LispObject *stacktop = stackbase+1; \
  87.    /*toplabel:*/ \
  88.       arg = ARG_0(stackbase); \
  89.  
  90. #define EUFUN_2(name,a1,a2) \
  91. LispObject name (stackbase) \
  92. LispObject *stackbase;        \
  93.   { \
  94.     LispObject a1; \
  95.     LispObject a2; \
  96.     LispObject *stacktop = stackbase+2; \
  97.  /*toplabel:*/ \
  98.     a1 = ARG_0(stackbase); \
  99.     a2 = ARG_1(stackbase);
  100.  
  101. #define EUFUN_3(name, a1, a2, a3) \
  102.   LispObject name (stackbase) \
  103.     LispObject *stackbase;   \
  104.     { \
  105.       LispObject a1; \
  106.       LispObject a2; \
  107.       LispObject a3; \
  108.       LispObject *stacktop = stackbase+3; \
  109.    /*toplabel:*/ \
  110.       a1 = ARG_0(stackbase); \
  111.       a2 = ARG_1(stackbase); \
  112.       a3 = ARG_2(stackbase);
  113.  
  114. #define EUFUN_4(name, a1, a2, a3, a4) \
  115.  LispObject name (stackbase)    \
  116.    LispObject *stackbase; \
  117.     { \
  118.       LispObject a1; \
  119.       LispObject a2; \
  120.       LispObject a3; \
  121.       LispObject a4; \
  122.       LispObject *stacktop = stackbase+4; \
  123.    /*toplabel:*/ \
  124.       a1 = ARG_0(stackbase); \
  125.       a2 = ARG_1(stackbase); \
  126.       a3 = ARG_2(stackbase); \
  127.       a4 = ARG_3(stackbase);
  128.       
  129. #endif    
  130.     /* tacky, but needed -- x is the number of args before the nested call 
  131.        hopefully, the optimiser will sort this little lot out */
  132. #define NEST(x,call) \
  133.     ( stacktop += x, *stacktop = call , stacktop += -x, *(stacktop+x))
  134.  
  135. #define STACK_TMP(x) (*stacktop = (x) , stacktop++) /* change cos of seq. points in
  136.                                NARY_PUSH */
  137. #define STACK_TMPV(x) *(stacktop++) = (LispObject)(x)
  138.  
  139. #define UNSTACK_TMP(x) (x) = *--stacktop
  140. #define UNSTACK_TMPV(x) (x) = (Env) *--stacktop
  141.  
  142. #define EUFUN_CLOSE  }
  143.  
  144. #define EUCALL_0(name) \
  145.    name (stacktop)
  146.  
  147. #define EUCALL_1(name, arg) \
  148.      ( \
  149.       ARG_0(stacktop) = arg, \
  150.       name (stacktop) \
  151.      )
  152.       
  153. #define EUCALL_2(name,arg1,arg2) \
  154.      ( \
  155.       ARG_0(stacktop) = arg1, \
  156.       ARG_1(stacktop) = arg2, \
  157.       name (stacktop) \
  158.      )                    
  159.                         
  160. #define EUCALL_3(name,arg1,arg2,arg3) \
  161.      ( \
  162.       ARG_0(stacktop) = arg1, \
  163.       ARG_1(stacktop) = arg2, \
  164.       ARG_2(stacktop) = arg3, \
  165.       name (stacktop) \
  166.      )              
  167.                   
  168. #define EUCALL_4(name,arg1,arg2,arg3,arg4) \
  169.      ( \
  170.       ARG_0(stacktop) = arg1, \
  171.       ARG_1(stacktop) = arg2, \
  172.       ARG_2(stacktop) = arg3, \
  173.       ARG_3(stacktop) = arg4, \
  174.       name (stacktop) \
  175.      )
  176.  
  177. #define EUCALLSET_0(val,name) val = name (stacktop)
  178.  
  179. #define EUCALLSET_1(val, name, arg) \
  180.      { \
  181.       ARG_0(stacktop) = arg; \
  182.       val = name (stacktop); \
  183.      }
  184.       
  185. #define EUCALLSET_2(val,name,arg1,arg2) \
  186.      { \
  187.       ARG_0(stacktop) = arg1; \
  188.       ARG_1(stacktop) = arg2; \
  189.       val = name (stacktop); \
  190.      }                    
  191.                         
  192. #define EUCALLSET_3(val,name,arg1,arg2,arg3) \
  193.      { \
  194.       ARG_0(stacktop) = arg1; \
  195.       ARG_1(stacktop) = arg2; \
  196.       ARG_2(stacktop) = arg3; \
  197.       val = name (stacktop); \
  198.      }              
  199.                   
  200. #define EUCALLSET_4(val,name,arg1,arg2,arg3,arg4) \
  201.      { \
  202.       ARG_0(stacktop) = arg1; \
  203.       ARG_1(stacktop) = arg2; \
  204.       ARG_2(stacktop) = arg3; \
  205.       ARG_3(stacktop) = arg4; \
  206.       val = name (stacktop); \
  207.       }
  208.  
  209. #define EULET(name,value) 
  210.  
  211. /* call a function with the same arguments.. assumes they are never changed */
  212. /* only a little dodgy */
  213.  
  214. #define RECALL(fun) fun (stackbase)
  215.  
  216. /* we don't use this often */
  217. #define EUTAIL_3(a1,a2,a3) \
  218.     {  *stackbase=a1;       \
  219.        *(stackbase+1) = a2;\
  220.        *(stackbase+2) = a3;\
  221.        stacktop = stackbase + 3 ;\
  222.        goto toplabel;       \
  223.      }               
  224.  
  225. #define BEGIN_NARY_EUCALL() \
  226.     do \
  227.       { LispObject *argbase = stacktop; \
  228.     int argcount=0;
  229.  
  230. #define NARY_PUSH_ARG(val)\
  231.     *(argbase+(argcount++))=val;
  232.     
  233. #define NARY_EUCALL(fun)  fun (argbase)
  234. #define NARY_EUCALL_1(fun,arg) fun(argbase,arg)      
  235. #define END_NARY_EUCALL() \
  236.     } while(0)
  237.  
  238. #define RETURN_EUCALL(call) do { stacktop=stackbase; return (call); } while (0)
  239.  
  240. #define DISCARD_OBJ() --stacktop
  241.  
  242.  
  243. #endif
  244.  
  245.  
  246.